home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / MYMUD21.ZIP / MMUD21.ZIP / SOURCE / SOURCE.ZIP / OUT_PROC.PAS < prev    next >
Pascal/Delphi Source File  |  1995-01-21  |  5KB  |  160 lines
  1. {$I COPYRGHT.INC}
  2.  
  3. (*---------------------------------------------------------------------------*
  4.   This unit contains the outputprocessing routines
  5.  *---------------------------------------------------------------------------*)
  6.  
  7. Unit Out_Proc;
  8. Interface
  9. Uses MyIO,
  10.      Header;
  11.  
  12. (*---------------------------------------------------------------------------*
  13.    Write a description text to the screen. Wrap the text at position 80.
  14.  *---------------------------------------------------------------------------*)
  15.  
  16. Procedure WriteText(T : TextRecord);
  17.  
  18. Procedure TranslateTextMacros(     Name   : String;
  19.                                    Gender : GenderType;
  20.                                Var T      : TextRecord);
  21.  
  22.  
  23. Implementation
  24. (*---------------------------------------------------------------------------*
  25.    Write a description text to the screen. Wrap the text at position 80.
  26.  *---------------------------------------------------------------------------*)
  27.  
  28. Procedure WriteText(T : TextRecord);
  29. Var Cnt : Word;
  30.     Len : Word;
  31.     Lines : Byte;
  32. Begin
  33. Cnt:=0;
  34. Len:=0;
  35. Lines:=0;
  36. While T[Cnt]<>#00 Do
  37.  Begin
  38.  Case T[Cnt] of
  39.    #10,
  40.    #13      : Begin
  41.               My_WriteLn('');
  42.               Len:=0;
  43.               If ((T[Cnt]=#13) And (T[Cnt+1]=#10)) Or
  44.                  ((T[Cnt]=#10) And (T[Cnt+1]=#13))
  45.                  Then Inc(Cnt);
  46.               Inc(Lines);
  47.               End;
  48.    '\'      : Begin
  49.               Inc(Cnt);
  50.               Case Upcase(T[Cnt]) Of
  51.                'N' : Begin
  52.                      My_WriteLn('');
  53.                      Len:=0;
  54.                      End;
  55.                'T' : My_Write(#9);
  56.                'R' : My_Write(#13);
  57.                'B' : My_Write(#8);
  58.                'F' : My_Write(#10);
  59.                'P' : My_Write(#27);
  60.                'G' : My_Write(#7);
  61.               End; {case}
  62.               End;
  63.   Else My_Write(T[Cnt]);
  64.  End; {Case}
  65.  Inc(Cnt);
  66.  Inc(Len);
  67.  If Len=79
  68.     Then Begin
  69.          If T[Cnt]<>' '
  70.             Then Begin
  71.                  While T[Cnt]<>' ' Do
  72.                   Begin
  73.                   Dec(Cnt);
  74.                   My_Write(#8' '#8);
  75.                   End;
  76.                  Inc(Cnt);
  77.                  End
  78.             Else Inc(Cnt);
  79.          My_WriteLn('');
  80.          Inc(Lines);
  81.          Len:=0;
  82.          End;
  83.  If Lines=20
  84.     Then Begin
  85.          Lines:=0;
  86.          My_waitForKey('--- More ---');
  87.          End;
  88.  End;
  89. My_WriteLn('');
  90. End;
  91.  
  92. (*---------------------------------------------------------------------------*)
  93. Procedure TranslateTextMacros(     Name   : String;
  94.                                    Gender : GenderType;
  95.                                Var T      : TextRecord);
  96. Var NewT : TextRecord;
  97.     Tcnt : Word;
  98.     NCnt : Word;
  99.     Tmp  : String[10];
  100.  
  101. Procedure Add(Var Where : Word; S: String);
  102. Var Cnt : Word;
  103. Begin
  104. Move(S[1],NewT[Where],Length(S));
  105. Where:=Where+Length(S)-1;
  106. End;
  107.  
  108. Begin
  109. TCnt:=0;
  110. NCnt:=0;
  111. FillChar(NewT,SizeOf(NewT),#00);
  112. While T[TCnt]<>#00 Do
  113.  Begin
  114.  If T[TCnt]<>MACRO_ESC
  115.     Then NewT[NCnt]:=T[TCnt]
  116.     Else Begin
  117.          Case T[TCnt+1] Of
  118.           'm','M' : Add(NCnt,MemMatch);
  119.           'n','N' : Add(NCnt,Name);
  120.           's','S' : Begin
  121.                     Case Gender Of
  122.                       None,Male : Tmp:='he';
  123.                       Female    : Tmp:='she';
  124.                       Neuter    : Tmp:='it';
  125.                     End;{case}
  126.                     If T[TCnt+1]='S'
  127.                        Then Tmp[1]:=Upcase(Tmp[1]);
  128.                     Add(NCnt,Tmp);
  129.                     End;
  130.           'o','O' : Begin
  131.                     Case Gender Of
  132.                       None,Male : Tmp:='him';
  133.                       Female    : Tmp:='her';
  134.                       Neuter    : Tmp:='it';
  135.                     End;{case}
  136.                     If T[TCnt+1]='O'
  137.                        Then Tmp[1]:=Upcase(Tmp[1]);
  138.                     Add(NCnt,Tmp);
  139.                     End;
  140.           'p','P' : Begin
  141.                     Case Gender Of
  142.                       None,Male : Tmp:='his';
  143.                       Female    : Tmp:='her';
  144.                       Neuter    : Tmp:='its';
  145.                     End;{case}
  146.                     If T[TCnt+1]='P'
  147.                        Then Tmp[1]:=Upcase(Tmp[1]);
  148.                     Add(NCnt,Tmp);
  149.                     End;
  150.  
  151.          End; {Case}
  152.          Inc(TCnt);
  153.          End;
  154.  Inc(TCnt);
  155.  Inc(NCnt);
  156.  End;
  157. T:=NewT;
  158. End;
  159.  
  160. End.